package EMS::Mailguard::MailguardSession;


# Depends on Mail::Internet
use EMS::Mailguard::Mailguardout;
use Data::Dumper;
use XML::Simple;

sub new{
  my $class = shift();
  my $self =  bless ({}, $class);
  my %required_arguments = (
        _data_glob_ref => undef,
        _listname => undef,
        _log_ref => undef,
        _db_ref  => undef,
        _conf_ref => undef,
        _memb_ref => undef,
        _bounce_param => undef,
        _debug => undef,
        @_);

  # The only permitted 'die' statement versus EMS::LogIt::Death in the
  # entirety of this program.  The reason being is that you can't run a
  # EMS::LogIt::Death unless you have a EMS::LogIt object. :)

  die("No logging object found")  unless ( $required_arguments{_log_ref} );

  # Get the original logging object for logging inside this object
  $self->{_log_object}=$required_arguments{'_log_ref'};
  $self->{_log_object}->add("Initializing MailguardSession Object");

  # Make sure that the required constructor arguments are there.
  for ( keys %required_arguments ){
     $self->{_log_object}->Death(682, "Required constructor <$_> argument missing in MailguardSession.pm") 
       unless ( defined ($required_arguments{$_}) );
  }

  # And now for the main work, setting the properties based on the parsing of
  # the INPUT glob ( AKA $required_arguments{data_glob_ref}

  # Set the listname, a handy thing to know
  $self->{_listname} = $required_arguments{_listname};
  $self->{_barons_listname} = $required_arguments{_listname} . "-barons";

  # Set up a preference for the bounceback to owner or to sender
  $self->{_bounceformat} = $required_arguments{'_bounce_param'};

  # Get the original configuration hash structure
  $self->{_conf_object}=$required_arguments{'_conf_ref'};

  # See if they want to bail out after the classification
  $self->{_debug} = $required_arguments{'_debug'};

  # Process everything that we can from the original GLOB of data (ARGUMENT 0)
  # Create a property with the original message in it
  my $handleRef = $required_arguments{'_data_glob_ref'};
  my @origArray = <$handleRef>;
  $self->{_original_source} =  \@origArray;


  # Sanitize the input, in case you're in an Exchange rich environment
  $self->{_qp_sanitized_source} = _qp_sanitize( $self->{_original_source} );

  # Store the message to an output file for auditing purposes
  # Comment this out when you don't want to fill the queue directory up!  Handy when writing / debugging

  $self->{_storefile} = 
  $self->_store_message_to_file($self->{_original_source},
                                $required_arguments{'_conf_ref'}{'storedir'});

  # Load it into a Mail::Internet Object
  $self->{_as_mail_internet} = _load_into_mail_internet ( $self->{_qp_sanitized_source} );
 
  # ... and have the head and body easily accessible
  $self->{_MI_header} = $self->{_as_mail_internet}->head();
  $self->{_MI_body}   = $self->{_as_mail_internet}->body();

  # Set a flag for denoting multi-part-ed-ness
  $self->{_multipart_flag} = $self->{_MI_header}->get('Content-type') =~ m|multipart| ? 1 : 0;

  # Extract values needed from configuration hash
  $self->{_local_domains} = $required_arguments{'_conf_ref'}{'our_domain'};
  $self->{_primary_domain} = $required_arguments{'_conf_ref'}{'our_domain'}[0];
  $self->{_ext_domains} = $required_arguments{'_conf_ref'}{'our_ext_domain'};

  # Derive information about the sender
  $self->{_mail_address} =  $self->_derive_mail_address($self->{_MI_header});
  ($self->{_userid}, $self->{_user_domain}) =  $self->_derive_id_and_domain($self->{_mail_address});
  $self->{_is_external_list} = $self->_determine_if_domain_is_external($self->domain(), $self->ext_domains);

  $self->{_user_is_local} = $self->_domain_is_local($self->domain(), $self->local_domains());

  unless ( $self->user_is_local() ){
    $self->{_external_from} = $self->_evaluate_external_from($self->{_MI_header}->get('from'));
  }

  # Who are members of this list?
  $self->{_list_members} = $required_arguments{_memb_ref};

  # Classify the sender
  $self->{_list_branch} = $required_arguments{'_db_ref'};
  $self->{_sender_classification} = $self->_classify_sender($self->userid(), 
                                                            $self->domain(),
                                                            $self->list_branch(), 
                                                            $self->local_domains());

  $self->{_behavior} = $self->_determine_behavior_for_classification($self->sender_classification());
  
  # It is frequently handy to manually set the behavior here:
  # e.g. $self->(_behavior} = 'drop';

  $self->{_summation} = _make_summation( $self->userid(), $self->sender_classification(), $self->behavior() );

  $required_arguments{_log_ref}->add ( $self->summation() );

  if ($self->{_debug} ){
    print STDERR "Reached DEBUG endpoint:  ";
    print STDERR $self->summation() . "\n";
    exit;
  }

  my %actionTable =(
                   forward        => \&_ForwardMessage,
                   escrow         => \&_EscrowMessage,
                   reject         => \&_RejectMessage,
                   drop           => \&_DropMessage,
                 );

  $actionTable{$self->behavior()}->($self) ;
 
  return $self;
}


###############################################################################
# Public Methods
###############################################################################

sub is_external_list{
  my $self=shift();
  return $self->{_is_external_list};
}

sub bounceformat{
  my $self=shift();
  return $self->{_bounceformat};
}

sub storefile{
  my $self=shift();
  return $self->{_storefile}; 
}

sub mail_address{
  my $self = shift();
  return $self->{_mail_address};
}

sub from_address{ #synonym to mail_address, makes more sense sometimes
  my $self = shift();
  return $self->{_mail_address};
}

sub head{
  my $self = shift();
  return $self->{_MI_header};
}

sub body{
  my $self = shift();
  return $self->{_MI_body};
}

sub queuedir(){
  $self=shift();
  return $self->{_conf_object}{queue_path};
}

sub listname{
  my $self=shift();
  return $self->{_listname};
}

sub is_multipart{
  my $self=shift();
  return $self->{_is_multipart}
}

sub barons_listname{
  my $self=shift();
  return $self->{_barons_listname};
}

sub baronslist{ # Synonym
  my $self=shift();
  return $self->{_barons_listname};
}

sub behavior{
  my $self=shift();
  return $self->{_behavior};
}

sub list_members{
  my $self=shift();
  return  $self->{_list_members};
}

sub sender_classification(){
  my $self=shift();
  return  $self->{_sender_classification};
}

sub external_from{
  my $self=shift();
  return  $self->{_external_from};
}

sub userid{
  my $self=shift();
  return  $self->{_userid};
}

sub user_is_local{
  my $self=shift();
  return $self->{_user_is_local};
}

sub list_branch{
  my $self=shift();
  return  $self->{_list_branch};
}

sub ext_domains{
  my $self=shift();
  return  $self->{_ext_domains};
}

sub local_domains{
  my $self=shift();
  return  $self->{_local_domains};
}

sub primary_domain{
  my $self=shift();
  return $self->{_primary_domain}
}

sub log{
  my $self=shift();
  return $self->{_log_object};
}

sub log_object{
  my $self=shift();
  return $self->{_log_object};
}

sub domain{
  my $self=shift();
  return $self->{_user_domain};
}

sub summation{
  my $self = shift();
  return $self->{_summation};
}


###############################################################################
# Private Methods
###############################################################################
sub _determine_if_domain_is_external{
  my $self=shift();
  my ($u, $aref) = @_;
  @ray = @$aref;
  
  for ( @ray ){
    return 1 if ( $u eq $_ );
  }
  return 0;
}

sub _message_as_sanitized_array{
  my $self=shift();
  my $justref=shift();

  return $self->{_qp_sanitized_source} if ( $justref );
  return @{+  $self->{_qp_sanitized_source} };
}

sub _store_message_to_file{
  my $self = shift();
  my @sourceArray = @{+ shift() };
  my $directory = shift();

  # This is a subroutine to take an incoming message out of the STDIN
  # handle, store the data into a text file and then return the message as a
  # raw text array reference (raw_message) as well as the name of the
  # location where the file has been written

  my ( $sec, $min, $hour, $mday, $mon, $year ) = localtime();

  $year += 1900;
  $mon += 1;
  my $queue_id = $self->queuedir() . "/" . $self->listname() . "\@$year.$mon.$mday-$hour:$min:$sec.$$";
  my $log = $self->log();

  print STDERR "Storing to $queue_id\n" ;
  $log->add( "Storing to $queue_id" );

  # I don't think we need this any more
  # chdir($directory);

  local $|=1;

  # Legacy, I'm not sure what advantage sysopen has over open.
  #sysopen(STOREFILE, ">$queue_id", O_WRONLY|O_EXCL|O_CREAT, 0666) or die "Could not open file: $queue_id: $! i was at" . `pwd` . "\n";

  open(STOREFILE, ">$queue_id") or 
    $log->Death(686, "Could not open file: $queue_id: $! i was at" . `pwd` . "\n");

  if (not -e STOREFILE){print "This is very bad!  I was unable to store the
    queue file due to: $!\n";}

  for (@sourceArray){
      print STOREFILE $_;
  }

  close STOREFILE;

  return $queue_id;

}

sub _make_summation{
  return "$_[0], a $_[1]-classified sender, triggers behavior $_[2]";
}

sub _determine_behavior_for_classification{
  my $self = shift();
  my $class = shift();
  my $l=$self->list_branch();

  return $l->{CONFIG}{$class};

}

sub _evaluate_external_from{
  ($self, $f )=@_;
  chomp $f;
  $f  =~ s#.*<(.*\@.*)>.*$#$1#g;
  return $f;
}

# This subroutine classifies the sender and returns a scalar 'noun' which
# classifies the sender as a certain type:
#    'daemon' 'barons' 'members' 'external' 'internal'
sub _classify_sender{
  my $self = shift();
  my ($user, $udom, $list, $doms)=@_;

  my $log=$self->log();
  
  $log->add("_classify_sender.userid: [$user]");

  $log->add("_classify_sender.sender_dom: [$udom]");
 
  $log->add("  BEGIN: _classify_sender.test_daemon"); 

     if ( ($user =~ /(MAILER-DAEMON)/) or
          ($user =~ /^owner/)){
          $log->add("    Daemon message detected: user = [$sender]");
          return 'daemon';
      }

  $log->add("  END: _classify_sender.test_daemon"); 


  $log->add("  BEGIN: _classify_sender.test_baron"); 

  my $listname = $self->listname();

    if (
        exists (
             $list->{BARONS}{$user} )
                   ){
           # This is an extra bit of error checking to make sure that the
           # sender is internally-based
           if  ($self->{_user_is_local} ){
             $log->add("   --> $user is a baron on $listname");
             return 'barons';
           }
       }else{
         $log->add("    $user is NOT a baron on $listname");
       }


  $log->add("  END: _classify_sender.test_baron"); 


  $log->add("  BEGIN: _classify_sender.test_member"); 

  my @members_of_list = @{+ $self->list_members() };
    if ( $self->user_is_local() ){
       my $u = $self->userid();
       if ( grep (m|^$u|i, @members_of_list )){
        $log->add("    --> Classified: Member"); 
         return 'members';
       }
    }else{
       $u = $self->{_external_from};
       if ( grep (m|^$u|i, @members_of_list )){
        $log->add("    --> Classified: Member"); 
         return 'members';
       }
    
    }
  $log->add("  END: _classify_sender.test_member"); 

  $log->add("  BEGIN: _classify_sender.test_external"); 
    unless ( $self->user_is_local() ){
      $log->add("    --> Classified: External"); 
       return 'external';
    } 
  $log->add("  END: _classify_sender.test_external"); 

  $log->add("  BEGIN: _classify_sender.test_internal"); 
    if ( $self->user_is_local() ){
      $log->add("    --> Classified: Internal"); 
       return 'internal';
    } 
  $log->add("  END: _classify_sender.test_internal"); 

  BADTHINGS:{
      $log->add("    --> Classified: ERROR"); 
     return 'error'
  }
  
  $log->add("END: _classify_sender");
  
}

sub _domain_is_local{
  my $self=shift();
  my ($u, $aref) = @_;
  @ray = @$aref;
  
  for ( @ray ){
    return 1 if ( $u eq $_ );
  }
  return 0;
}

sub _derive_id_and_domain{
  my ($self, $address) = @_;
  my @tempray = split (/@/, $address);
  return @tempray;
}


sub _derive_mail_address{
  my ($self, $mh) = @_;
  chomp($_ = $mh->get('from'));
  s,\n,,g;
  s#.*\<(\w+(?:\.\w+)*@\w+(?:\.\w+)*)\>.*#$1#;
  s#[\<\>]##g;
  ($_) = grep {/\@/} (split /\s+/);
  return $_;
}

sub _load_into_mail_internet{
  use Mail::Internet;
  my $mi = Mail::Internet->new( $_[0] );
}

sub _qp_sanitize{
  my $source_array_reference = shift();
  my @sanitized_array;
  
  use MIME::QuotedPrint qw(decode_qp);
  for ( @$source_array_reference ){
    push (@sanitized_array, decode_qp($_) );
  }
 
  return \@sanitized_array;
  
}

###############################################################################
# Mailguard Send Operations
###############################################################################
sub _EscrowMessage{
    my %CONFIG = %{+ $self->{_conf_object}};
    my $head = $self->head();
    my $log = $self->log();
    $log->add("START EscrowMessage Routine");

    
    $log->add("    START BaronsNotify Routine");
    BARONSNOTIFY:{
      my $OUTBOUND_MAIL_CONFIGURATION_DATA
        = XMLin($CONFIG{xmlfile},
                 Variables  => {
                                from_variable =>
                    $self->from_address(),
                                to_variable =>
                    $self->baronslist(),
                                subject_variable =>
                    $head->get('Subject'),
                                date_variable =>
                    $head->get('Date'),
                                listname =>
                    $self->listname()
                   });

      my $outbound_mail = new EMS::Mailguard::Mailguardout ( logobject => $log) or
        $log->Death (909,"<DeathLocus 6>Could not create mail send object $!");

      my $temp_pd = $self->primary_domain();

      if ( $self->is_multipart() ){
        use MIME::Lite;
        MIME::Lite->send('smtp', "outbound.$temp_pd", Timeout=>60);

        # Create a new multipart message:
        $msg = new MIME::Lite
                 From     =>"mailguard\@$temp_pd",
                 To       =>$OUTBOUND_MAIL_CONFIGURATION_DATA{to_variable},
                 Subject  =>$OUTBOUND_MAIL_CONFIGURATION_DATA->
                                      {escrowed_message_configuration_for_baron}->
                                      {subject_blurb}
                                         . $head->get('Subject'),
                 Type    =>'TEXT',
                 Data    => $OUTBOUND_MAIL_CONFIGURATION_DATA->
                    {escrowed_message_configuration_for_baron}->{body_to_insert_multi};

        # Attach a part:
        attach $msg Type     =>'message/rfc822',
                    Path     =>$self->storefile(),
                    Filename =>'sample';
        $msg->send();
      }else{ # (is not multipart)
        $outbound_mail->SendMessage(
          additional_headers =>
            $OUTBOUND_MAIL_CONFIGURATION_DATA->
               {escrowed_message_configuration_for_baron}->{headers_to_insert},
          recipients => [ $self->baronslist() ],
          body_text_blurb =>
            $OUTBOUND_MAIL_CONFIGURATION_DATA->
               {escrowed_message_configuration_for_baron}->{body_to_insert_pt},
          message_params => {
                              Subject => $OUTBOUND_MAIL_CONFIGURATION_DATA->
                                      {escrowed_message_configuration_for_baron}->
                                      {subject_blurb}
                                         . $head->get('Subject'),
                              To =>$self->baronslist() .
                              "\@$temp_pd",
                              From =>"mailguard\@$temp_pd",
                              Date => $head->get('Date'),
                              Message =>join ('',$self->_message_as_sanitized_array())
                            }
         );# End SendMessage
      } # End if / else is_multipart
    }
    $log->add("    END BaronsNotify Routine");

    $log->add("    START UserNotify Routine");

    USERNOTIFY:{
      $OUTBOUND_MAIL_CONFIGURATION_DATA
        = XMLin($CONFIG{xmlfile},
                 Variables  => {
                                listname =>
                    $self->listname(),
                                to_variable =>
                    $self->from_address(),
                                subject_variable =>
                    $head->get('Subject'),
                                date_variable =>
                    $head->get('Date'),
                                domain_variable => shift( @{+ $CONFIG{'our_domain'} })
                   }, KeyAttr => {header=>+value} );


    my $outbound_mail = new EMS::Mailguard::Mailguardout ( logobject => $log ) or
     $log->Death (676, "<DeathLocus 4>Could not create mail send object: $!");

    my $class =  $self->sender_classification();
    my $branch =  $self->list_branch();

    my $escrow_blurb;
    if ($class eq 'internal'){
      $escrow_blurb = $branch->{INTESCROW}
    }elsif($class eq 'external'){
      $escrow_blurb = $branch->{EXTESCROW}
    }elsif($class eq 'barons'){
      # Barons are assumed to be internal
      $escrow_blurb = $branch->{INTESCROW}
    }elsif($PARAMETERS_FOR_THIS_EXECUTION{'sender_classification'} eq 'members'){
      if ( $self->user_is_local()){
          $escrow_blurb = $branch->{INTESCROW}
        }else{
          $escrow_blurb = $branch->{EXTESCROW}
        } #end is it a members in our domain?
    }else{
        $escrow_blurb = "This message has been escrowed per list configuration. You may want to send mail to " .  $self->listname() . 
                        "-barons for further help.\n\n"
    }

    my $temp_pd = $self->primary_domain();

    if ( $self->is_multipart() ){
      $log->add("In notifying sender, the message that came in was multipart.");

      use MIME::Lite;
      MIME::Lite->send('smtp', "localhost.$temp_pd", Timeout=>60);

      # Create a new multipart message:
      $msg = new MIME::Lite(
               From     =>"mailguard\@$temp_pd",
               To       =>$self->from_address(),
               Subject  =>$OUTBOUND_MAIL_CONFIGURATION_DATA->
                                    {escrowed_message_configuration_for_sender}->
                                    {subject_blurb}
                                       . $head->get('Subject'),
               Type     =>'TEXT',
               Data     =>$escrow_blurb);

      # Attach a part:
      attach $msg Type     =>'message/rfc822',
                  Path     =>$self->storefile(),
                  Filename =>'sample';
      $msg->send();
    }else{
      $log->add("In notifying sender, the message that came in was NOT multipart.");
        $outbound_mail->SendMessage(
          additional_headers =>
            $OUTBOUND_MAIL_CONFIGURATION_DATA->
               {escrowed_message_configuration_for_sender}->{headers_to_insert},
          recipients => [ $self->from_address()  ],
          body_text_blurb => $escrow_blurb,
          message_params => {
                              Subject => $OUTBOUND_MAIL_CONFIGURATION_DATA->
                                      {escrowed_message_configuration_for_sender}->
                                      {subject_blurb}
                                         . $head->get('Subject'),
                              From => "mailguard\@$temp_pd",
                              To =>$self->from_address(),
                              Date => $head->get('Date'),
                              Message =>join ('',$self->_message_as_sanitized_array() )
                            }
         ); # End SendMessage
    } # End if_multipart/else

      }# End usernotify


    $log->add("    END UserNotify Routine");
    $log->add("END EscrowMessage Routine" );
    
  # Running this will add -Processed to the file's ending making it invisible
  # to the management queue scripts.  You do not want this.  Left in as a
  # cautionary tale.

  # $self->_rename_file_as_PROCESSED($self->storefile());
}



sub _RejectMessage{
    my %CONFIG = %{+ $self->{_conf_object}};
    my $head = $self->head();
    my $log = $self->log();
    $log->add("START RejectMessage Routine");
    
    # Load up a structure containing generic "reject" structures with
    # variables set with content that is reasonable for the context
    # of this case

    my $OUTBOUND_MAIL_CONFIGURATION_DATA
      = XMLin($CONFIG{xmlfile},
               Variables  => {
                             date_variable =>
                               $head->get('Date'),
                             subject_variable =>
                               $head->get('Subject'),
                             listname_variable =>
                               $self->listname(),
                             domain_variable =>
                               shift( @{+ $CONFIG{'our_domain'} } )
                            }
              );

    # Determine the rejection blurb based on their internal / external status
    my $class =  $self->sender_classification();
    my $branch =  $self->list_branch();

    my $rejection_blurb;
    if ($class eq 'internal') {
      $rejection_blurb = $branch->{INTREJECT}
    }elsif($class eq 'external'){
      $rejection_blurb = $branch->{EXTREJECT}
    }elsif($class eq 'members'){
      # Despite being a member of the list, we need to respect whether they're
      # @$self->primary_domain() or not.
      if ( $self->user_is_local() ){
        $rejection_blurb = $branch->{INTREJECT}
      }else{
        $rejection_blurb = $branch->{EXTREJECT}
      }
    }
 
    my $outbound_mail = new EMS::Mailguard::Mailguardout ( logobject => $log) or
      $log->Death (909,"<DeathLocus 6>Could not create mail send object $!");

  # This can get rather verbose in the logs...
  #$log->add("Rejection blurb was: $rejection_blurb");

  my $temp_pd = $self->primary_domain();

  $log->add($self->from_address());

  $outbound_mail->SendMessage(
    additional_headers =>
      $OUTBOUND_MAIL_CONFIGURATION_DATA->{rejectconfiguration}->{headers_to_insert},
    recipients => [ $self->from_address() ],
    body_text_blurb => $rejection_blurb ,
    message_params => {
                        Subject => "[ MAILGUARD REJECTED MESSAGE ] RE: " .
                                    $head->get('Subject'),
                        To => $self->from_address(),
                        Date => $head->get('Date'),
                        From => "mailguard\@$temp_pd",
                      }
  );

  $self->_rename_file_as_PROCESSED($self->storefile());
  $log->add("END RejectMessage Routine");
}

sub _rename_file_as_PROCESSED{
  my $self = shift();
  my $file = shift();
  my $log = $self->log();

  $log->add("I am moving $file to $file-PROCESSED");
  print STDERR "I am moving $file to $file-PROCESSED\n";
  rename $file, "$file-PROCESSED";
}

###############################################################################
# Mailguard Action Routines
###############################################################################

sub _DropMessage {
    my $log = $self->log();
    $log->add("BEGIN DropMessage");
    $self->_rename_file_as_PROCESSED($self->storefile());
    $log->add("END DropMessage");
    $log->Death(0,"Drop Message Routine Was Implemented, not really a DEATH");
}

sub _ForwardMessage{
    my $self = shift();
    my %CONFIG = %{+ $self->{_conf_object}};
    my $head = $self->head();
    my $log = $self->log();

    $log->add("BEGIN ForwardMessage");


    my $OUTBOUND_MAIL_CONFIGURATION_DATA
        = XMLin($CONFIG{xmlfile},
                 Variables  => {
                                from_variable =>
                    $self->from_address(),
                                to_variable =>
                    $self->listname() . "-filtered",
                                cc_variable =>
                    $head->get('CC'),
                                subject_variable =>
                    $head->get('Subject'),
                                date_variable =>
                    $head->get('Date'),
                                message_id_variable =>
                    $head->get('Message-ID'),
                                list_id_variable =>
                    $head->get('List-ID'),

                   });

    my $outbound_mail = new EMS::Mailguard::Mailguardout ( logobject => $log ) or
     $log->Death (698, "<DeathLocus 5>Could not create mail send object: $!");

    my $MI = $self->{_as_mail_internet};
    my $MH = $self->head();

    # Not necessary, but for the message to make sense headers-wise you should
    # definitely do this
    $MH->delete('Received');

    # The address you want to appear on the to field
    # Note this is different from the place you acutally wind up sending it!
    $MH->replace('Subject', $head->get('Subject'));

    #Vanitas
    $MH->add('X-Mailguard-Protected-List', $self->listname());
    $MH->add('X-Mailguard-Version', '2.0 pre-Public');

    $log->add("Bounce error configuration is: $bounce_formatting_type");

    if ( $self->bounceformat() eq 'owner' ){
        if ( $self->is_external_list() ){
          $envelope_from = "owner-extdom." .
                           $self->listname() ."\@" . shift( @{+ $CONFIG{'our_domain'} });
        }else{
          $envelope_from = "owner-"  . $self->listname() . "\@" . shift( @{+ $CONFIG{'our_domain'} });
        }
    }elsif ( $self->bounceformat() eq 'sender' ){
      $envelope_from = $self->from_address();
    }

  $log->add("------------------");
  $log->add("Sendmail command is: |/usr/lib/sendmail -odb -f $envelope_from "
    . $self->listname() .  "-filtered");

  my $handle = "|/usr/lib/sendmail -odb -f " .
                $envelope_from .  " " .
                $self->listname()  .
               "-filtered";

  $log->add("Outbound handle opened was: $handle");
  $log->add("Closing outbound handle.");

  
  open (OUT, $handle) or $log->Death(683, "Could not open the forward Message
  output stream: $!");
  $MI->print(\*OUT);
  close OUT;

  $log->add("Renaming file as sent:  File was: " . $self->storefile());

  $self->_rename_file_as_PROCESSED($self->storefile());

}

######################################################################
# POD Documentation
######################################################################

=pod

=head1 

EMS::Mailguard::MailguardSession

=head2 

Synopsis

A module for performing the logic and work associated with a given execution of
the Mailguard program.  Half of the program is devoted to deriving a user's
B<Summation>, that is, mailing address, classification, and behavior for that
classification.  The second half of the program is based on using the behavior
value as the key to a dispatch table that will launch the actions associated
with that behavior: forwarding the message on, destroying it silently, etc.

=head2 Constructor ( All Paramters Listed are B<REQUIRED> )

=over 4

=item *

B<_data_glob_ref>: GLOBREF:  Stream of data ( generally coming from <STDIN> or
a filehandle )

=item *

B<_listname>:  SCALAR: Name of the list that's being operated upon

=item *

B<_log_ref>:  EMS::LogIt Object:  Object for logging to a file

=item *

B<_db_ref >:  HASHREF:  Refences to a Hash Database branch associated with
B<_listname>

=item *

B<_conf_ref>:  HASHREF:  Configuration hash; generally derived from
EMS::Mailguard::Config.pm

=item *

B<_memb_ref>:  ARRAYREF:  Array of subscribers to the list B<_listname>

=item *

B<_bounce_param>: SCALAR:  Field containing envelope-from bounce option
configuration setting

=item *

B<_debug>:  SCALAR (BOOLEAN):  Should the program abort after loading the
constructors and evaluating the behavior of the sender viz. configuration of
the list.

=back

=head 2

Public Methods

=over 4

=item *

is_external_list()

=over 2

=item * ARGUMENTS: none

=item * RETURN:  (BOOLEAN) $self->{_is_external_list}

=item * DESCRIPTION: Returns TRUE if a list has been determined to be an
external list.  Came from a domain specified in the config under
'our_ext_domain'

=back 

=item *

bounceformat()

=over 2

=item * ARGUMENTS: none

=item * RETURN:  $self->{_bounceformat}

=item * DESCRIPTION: (SCALAR) Value was passed in via constructor
(B<_bounce_param>), returns value for how envelope-from should be defined.

=back


=item *

storefile()


=over 2

=item * ARGUMENTS: none

=item * RETURN:  $self->{_storefile}

=item * DESCRIPTION: (SCALAR) Path to stored copy of the message that came in
via the constructor value B<_data_glob_ref>

=back

=item *

mail_address()

=over 2

=item * ARGUMENTS: none

=item * RETURN:  (SCALAR)$self->{_mail_address}

=item * DESCRIPTION: A scrubbed version of the Mail::Header "From" derived from
the GLOBREF 

=item * SYNONYM: from_address()

=back


=item *

head()

=over 2

=item * ARGUMENTS: none

=item * RETURN:  $self->{_MI_header}

=item * DESCRIPTION: (OBJECT) A Mail::Header object derived from the GLOBREF

=back

=item *

body()

=over 2

=item * ARGUMENTS: none

=item * RETURN:  $self->{_MI_body}

=item * DESCRIPTION: (OBJECT) A Mail::Body object derived from the GLOBREF

=back

=item *

queuedir()()



=over 2


=item * ARGUMENTS: none

=item * RETURN:  $self->{_conf_object}{queue_path}

=item * DESCRIPTION: (SCALAR) Path to where storefile() stores messages

=back

=item *

listname()

=over 2

=item * ARGUMENTS: none

=item * RETURN:  $self->{_listname}

=item * DESCRIPTION:  (SCALAR) The name of the list that's being worked upon.

=back

=item *

is_multipart()



=over 2

=item * ARGUMENTS: none

=item * RETURN: (SCALAR / BOOLEAN)  $self->{_is_multipart}

=item * DESCRIPTION: Is the message plaintaxt or using MIME

=back

=item *

barons_listname()



=over 2


=item * ARGUMENTS: none

=item * RETURN:  $self->{_barons_listname}

=item * DESCRIPTION: (SCALAR) Return the barons list name

=item * SYNONYM:  baronslist()

=back


=item *

behavior()



=over 2


=item * ARGUMENTS: none

=item * RETURN:  $self->{_behavior}

=item * DESCRIPTION: (SCALAR) (forward|escrow|drop|reject) : The values
determined based on processing the sender classification against the database
branch.  e.g.  User is of type class, parsed against listname's configuration in the
database passed in the constructor means class member's mail should be
classified as 'forward'.  Therefore run the ForwardMessage routine.

=back

=item *

list_members()



=over 2


=item * ARGUMENTS: none

=item * RETURN :  $self->{_list_members}

=item * DESCRIPTION: (ARRAYREF) Returns array of members passed in via the
constructor in B<_memb_ref>

=back

=item *

sender_classification()



=over 2


=item * ARGUMENTS: none

=item * RETURN :  $self->{_sender_classification}

=item * DESCRIPTION: (internal|external|member|baron) : The values determined
based on processing the sender classification against the member's lists and
barons lists.

e.g.  User stharms is parsed against listname's barons membership and is
determined to be a member of the barons list.  Thus value is 'barons'.  User
misscake isn't in barons membership but *is* a member.  Thus value is 'barons'.
User kinghobo comes from a domain listed in 'our_domain'.  Thus value is
'internal'.

=back

=item *

external_from()



=over 2


=item * ARGUMENTS: none

=item * RETURN :  $self->{_external_from}

=item * DESCRIPTION: (SCALAR)  An "original" From: field from the header.  The
processing often tries to get a 'sender' from the From field.  In case the
original is needed before any processing, a pure, virginal insance of From,
this is the way to get it.

=back

=item *

userid()



=over 2


=item * ARGUMENTS: none

=item * RETURN :  $self->{_userid}

=item * DESCRIPTION: (SCALAR):  What's to the left of the "@" sign in the email
From address.

=back

=item *

user_is_local()



=over 2


=item * ARGUMENTS: none

=item * RETURN:  $self->{_user_is_local}

=item * DESCRIPTION: (SCALAR/BOOLEAN) Is the domain in the From field ( to the
right of the "@" sign ) defined as a member in our 'our_domain' configuration
parameter?

=back

=item *

list_branch()



=over 2


=item * ARGUMENTS: none

=item * RETURN :  $self->{_list_branch}

=item * DESCRIPTION: (HASHREF)  Receive the list 'branch' from the database
passed into the constructor as B<_db_ref>

=back

=item *

ext_domains()



=over 2


=item * ARGUMENTS: none

=item * RETURN :  $self->{_ext_domains}

=item * DESCRIPTION: (ARRAYREF) Domains that we consider 'external'.  Defined
in CONFIG; passed in as B<_conf_ref>

=back

=item *

local_domains()



=over 2


=item * ARGUMENTS: none

=item * RETURN :  $self->{_local_domains}

=item * DESCRIPTION:  (ARRAYREF) Domains that we consider 'local'.  Defined in
CONFIG; passed in as B<_conf_ref>

=back

primary_domain()



=over 2


=item * ARGUMENTS: none

=item * RETURN :  String:  First domain listed in the list of local domains

=item * DESCRIPTION:  (STRING) The "main domain" you recognize and relay as.

=back

local_domains()



=over 2


=item * ARGUMENTS: none

=item * RETURN :  $self->{_local_domains}

=item * DESCRIPTION:  (ARRAYREF) Domains that we consider 'local'.  Defined in
CONFIG; passed in as B<_conf_ref>

=back
=item *

log_object()



=over 2


=item * ARGUMENTS: none

=item * RETURN:  $self->{_log_object}

=item * DESCRIPTION: (OBJECT) Logging object passed in during constructor as
B<_log_ref>

=item * SYNONYM: log()

=back

=item *

domain()



=over 2


=item * ARGUMENTS: none

=item * RETURN:  $self->{_user_domain}

=item * DESCRIPTION: (SCALAR) Domain of the user ( what's to the right of the
"@" sign in the from field )

=back

=item *

summation()



=over 2


=item * ARGUMENTS: none

=item * RETURN:  $self->{_summation}

=item * DESCRIPTION: (SCALAR) A sentence that defines who the user was, what
his class was, and what behavior that triggered.  That is the last thing seen
when the Debug flag is enabled.

=back

=head2 Semi-Private Methods

After deriving the behavior for a message, that behavior is passed as the key to the %actionTable dispatch table.  This table performs one of 4 methods:

=over 4

=item * 

_ForwardMessage:  Forward the message on as if Mailguard had never seen it ( minus som X-headers ;) )

=item * 

_EscrowMessage:  Put the message in a holding pen, notify the sender, notify the barons list

=item * 

_RejectMessage:  Bounce the message back, out-of-hand

=item * 

_DropMessage: Silently destroy the message

=back

=back

=head2 Dependencies

MailguardSession has all the same dependencies as Mailguard.pl, but it should
be noted that MailguardSession also invokes a class called
EMS::Mailguard;:Mailguardout.  This is a wrapper around Mail::Sendmail which
enables bits of the ForwardMessage routine to be faster.


=head2 AUTHOR

Steven G. Harms (stharms@cisco.com)


=cut

return 1;
